home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 076-100 / disk_077 / quest / qcrt.d < prev    next >
Text File  |  1992-05-06  |  14KB  |  679 lines
  1. #include:util.g
  2. #include:crt.g
  3.  
  4. /*
  5.  * CRT library for Quest system.
  6.  */
  7.  
  8. ushort
  9.     NLINES = 23,            /* # lines on screen */
  10.     NCOLUMNS = 79,            /* # columns on screen */
  11.     TEXTTOP = (NLINES + 1) / 2,     /* 0-origin # of first text line */
  12.     STATUSLEFT = (NCOLUMNS + 1) / 2,    /* 0-origin # of first status col */
  13.     MAPLINES = TEXTTOP - 1,        /* # lines in map window */
  14.     MAPCOLUMNS = STATUSLEFT / 2 - 1;    /* # columns in map window */
  15.  
  16. type
  17.  
  18.     /* type of object, etc. id's: */
  19.  
  20.     Id_t = ulong,
  21.  
  22.     /* type of a map displayable object list: */
  23.  
  24.     Object_t = struct {
  25.     *Object_t ob_next;        /* ptr to next (behind this one) */
  26.     Id_t ob_id;            /* object's id */
  27.     long ob_line, ob_column;    /* world co-ords of object */
  28.     [2]char ob_chars;        /* chars to display */
  29.     },
  30.  
  31.     StatusKind_t = enum {st_number, st_string, st_multiple},
  32.  
  33.     /* type of a status area object: */
  34.  
  35.     Status_t = struct {
  36.     *Status_t st_next;        /* ptr to next in list */
  37.     Id_t st_id;            /* status object's id */
  38.     *char st_name;            /* heading for status object */
  39.     ushort st_line, st_column;    /* position in status area */
  40.     ushort st_length;        /* length of display */
  41.     StatusKind_t st_kind;        /* kind of this status object */
  42.     union {
  43.         *long n_ptr;        /* pointer to value */
  44.         **char s_ptr;        /* pointer to string */
  45.         proc(bool first)*char m_gen;/* value generator */
  46.     } st_;
  47.     };
  48.  
  49. Id_t ID_NULL = 0;
  50.  
  51. proc(long line, column)[2]char Scenery; /* user's scenery generator */
  52. *char TextPrompt;            /* current input prompt */
  53. ushort
  54.     TextLine,                /* current text line */
  55.     TextColumn,             /* current text column */
  56.     TextLinePos,            /* pos in TextBuff of next char */
  57.     TextWordPos;            /* pos in TextBuff of "word" */
  58. [NCOLUMNS] char TextBuff;        /* the current output text line */
  59. *Object_t Objects;            /* list of objects, sorted by l, c */
  60. long WindowLine, WindowColumn;        /* co-ords of center of window */
  61.  
  62. *Status_t Statuses;            /* list of display statuses */
  63.  
  64. /*
  65.  * _scAbort - abort with an error message.
  66.  */
  67.  
  68. proc _scAbort(*char message)void:
  69.  
  70.     CRT_ClearLine(NLINES - 1);
  71.     writeln(message);
  72.     CRT_Abort();
  73. corp;
  74.  
  75. /*
  76.  * scInit - screen initialization.
  77.  */
  78.  
  79. proc scInit()void:
  80.     ushort i;
  81.  
  82.     CRT_Initialize("Quest V0.5", NLINES, NCOLUMNS);
  83.     TextPrompt := "";
  84.     TextLine := TEXTTOP;
  85.     TextColumn := 0;
  86.     TextLinePos := 0;
  87.     TextWordPos := 0;
  88.     Objects := nil;
  89.     Statuses := nil;
  90.     CRT_ClearScreen();
  91.     CRT_Move(MAPLINES, 0);
  92.     for i from 0 upto NCOLUMNS - 1 do
  93.     CRT_PutChar('-');
  94.     od;
  95.     for i from 0 upto MAPLINES - 1 do
  96.     CRT_Move(i, MAPCOLUMNS * 2 + 1);
  97.     CRT_PutChar('|');
  98.     od;
  99.     CRT_Move(TEXTTOP, 0);
  100. corp;
  101.  
  102. /*
  103.  * scObjFree - free a list of objects
  104.  */
  105.  
  106. proc scObjFree(*Object_t ob)void:
  107.     *Object_t obt;
  108.  
  109.     while ob ~= nil do
  110.     obt := ob;
  111.     ob := ob*.ob_next;
  112.     free(obt);
  113.     od;
  114. corp;
  115.  
  116. /*
  117.  * scTerm - terminate the entire run
  118.  */
  119.  
  120. proc scTerm()void:
  121.     *Status_t st;
  122.     *Object_t ob;
  123.  
  124.     scObjFree(Objects);
  125.     while Statuses ~= nil do
  126.     st := Statuses;
  127.     Statuses := st*.st_next;
  128.     free(st);
  129.     od;
  130.     CRT_Terminate();
  131. corp;
  132.  
  133. /*
  134.  * _scFlush - flush the text line upto the given point.
  135.  */
  136.  
  137. proc _scFlush(ushort pos)void:
  138.     ushort i;
  139.  
  140.     CRT_Move(TextLine, 0);
  141.     i := 0;
  142.     while i ~= pos do
  143.     CRT_PutChar(TextBuff[i]);
  144.     i := i + 1;
  145.     od;
  146. corp;
  147.  
  148. /*
  149.  * _scNextLine - go to the next line on text output.
  150.  */
  151.  
  152. proc _scNextLine(bool needPause)void:
  153.     *char p;
  154.     ushort l;
  155.  
  156.     TextLine := TextLine + 1;
  157.     if TextLine = NLINES then
  158.     TextLine := TEXTTOP;
  159.     if needPause then
  160.         p := "M O R E";
  161.         l := TEXTTOP;
  162.         CRT_EnterHighLight();
  163.         while
  164.         l := l + 1;
  165.         CRT_Move(l, NCOLUMNS - 1);
  166.         p* ~= '\e'
  167.         do
  168.         CRT_PutChar(p*);
  169.         p := p + 1;
  170.         od;
  171.         CRT_ExitHighLight();
  172.         pretend(CRT_ReadChar(), void);
  173.     fi;
  174.     CRT_ClearToEnd(TEXTTOP);
  175.     else
  176.     CRT_Move(TextLine, 0);
  177.     fi;
  178. corp;
  179.  
  180. /*
  181.  * _scNewLine - a new line on text output.
  182.  */
  183.  
  184. proc _scNewLine(bool needPause)void:
  185.  
  186.     _scFlush(TextLinePos);
  187.     _scNextLine(needPause);
  188.     TextColumn := 0;
  189.     TextLinePos := 0;
  190.     TextWordPos := 0;
  191. corp;
  192.  
  193. /*
  194.  * scPut - put a character to the text display area.
  195.  */
  196.  
  197. proc scPut(char ch)void:
  198.  
  199.     if ch = '\r' then
  200.     /* ignore it - assume it only comes with '\n' */
  201.     elif ch = '\n' then
  202.     _scNewLine(true);
  203.     else
  204.     if TextColumn >= NCOLUMNS - 1 then
  205.         if TextWordPos ~= 0 and ch ~= ' ' and ch ~= '\t' then
  206.         _scFlush(TextWordPos);
  207.         TextColumn := TextLinePos - TextWordPos;
  208.         BlockMove(pretend(&TextBuff[0], *byte),
  209.               pretend(&TextBuff[TextWordPos], *byte),
  210.               TextColumn);
  211.         TextWordPos := 0;
  212.         TextLinePos := TextColumn;
  213.         _scNextLine(true);
  214.         else
  215.         _scNewLine(true);
  216.         if ch = ' ' or ch = '\t' then
  217.             ch := '\e';
  218.         fi;
  219.         fi;
  220.     fi;
  221.     if ch ~= ' ' and ch ~= '\t' and TextLinePos ~= 0 and
  222.         (TextBuff[TextLinePos - 1] = ' ' or
  223.          TextBuff[TextLinePos - 1] = '\t') then
  224.         TextWordPos := TextLinePos;
  225.     fi;
  226.     if ch ~= '\e' then
  227.         TextBuff[TextLinePos] := ch;
  228.         TextLinePos := TextLinePos + 1;
  229.         TextColumn :=
  230.         if ch = '\t' then
  231.             (TextColumn + 8) & 0xf8
  232.         else
  233.             TextColumn + 1
  234.         fi;
  235.     fi;
  236.     fi;
  237. corp;
  238.  
  239. /*
  240.  * scPrompt - set up the prompt to use for subsequent reads.
  241.  */
  242.  
  243. proc scPrompt(*char prompt)void:
  244.  
  245.     TextPrompt := prompt;
  246. corp;
  247.  
  248. /*
  249.  * scRead - read an input line.
  250.  */
  251.  
  252. proc scRead(*char buffer)void:
  253.  
  254.     if TextLinePos ~= 0 then
  255.     _scNewLine(true);
  256.     else
  257.     CRT_Move(TextLine, 0);
  258.     fi;
  259.     CRT_PutChars(TextPrompt);
  260.     CRT_GetLine(buffer, NCOLUMNS - CharsLen(TextPrompt));
  261.     _scNewLine(false);
  262. corp;
  263.  
  264. /*
  265.  * scNewMap - switch to a new "map" display.
  266.  */
  267.  
  268. proc scNewMap(proc(long l, c)[2]char scenery;
  269.              *Object_t newList)*Object_t:
  270.     *Object_t oldList;
  271.  
  272.     WindowLine := - range(long) - 1;
  273.     WindowColumn := - range(long) - 1;
  274.     oldList := Objects;
  275.     Objects := newList;
  276.     Scenery := scenery;
  277.     oldList
  278. corp;
  279.  
  280. /*
  281.  * scWindow - window map region to another location.
  282.  */
  283.  
  284. proc scWindow(long line, column)void:
  285.     *Object_t p;
  286.     long l, c;
  287.     [2]char pattern;
  288.  
  289.     if line ~= WindowLine or column ~= WindowColumn then
  290.     p := Objects;
  291.     for l from line - MAPLINES / 2 upto line + (MAPLINES - 1) / 2 do
  292.         while p ~= nil and p*.ob_line < l do
  293.         p := p*.ob_next;
  294.         od;
  295.         CRT_Move(l - line + MAPLINES / 2, 0);
  296.         for c from column - MAPCOLUMNS / 2
  297.             upto column + (MAPCOLUMNS - 1) / 2 do
  298.         while p ~= nil and p*.ob_line = l and
  299.             p*.ob_column < c do
  300.             p := p*.ob_next;
  301.         od;
  302.         pattern :=
  303.             if p ~= nil and p*.ob_line = l and
  304.                 p*.ob_column = c then
  305.             p*.ob_chars
  306.             else
  307.             Scenery(l, c)
  308.             fi;
  309.         CRT_PutChar(pattern[0]);
  310.         CRT_PutChar(pattern[1]);
  311.         od;
  312.     od;
  313.     WindowLine := line;
  314.     WindowColumn := column;
  315.     fi;
  316. corp;
  317.  
  318. /*
  319.  * _scOnScreen - check for a position visible. Move there if so.
  320.  */
  321.  
  322. proc _scOnScreen(long line, column)bool:
  323.  
  324.     if line >= WindowLine - MAPLINES / 2 and
  325.         line <= WindowLine + (MAPLINES - 1) / 2 and
  326.         column >= WindowColumn - MAPCOLUMNS / 2 and
  327.         column <= WindowColumn + (MAPCOLUMNS - 1) / 2 then
  328.     CRT_Move(line - WindowLine + MAPLINES / 2,
  329.          (column - WindowColumn + MAPCOLUMNS / 2) * 2);
  330.     true
  331.     else
  332.     false
  333.     fi
  334. corp;
  335.  
  336. /*
  337.  * _scInsert - insert an object into the location sorted list.
  338.  */
  339.  
  340. proc _scInsert(*Object_t p; long line, column)void:
  341.     **Object_t pp;
  342.  
  343.     p*.ob_line := line;
  344.     p*.ob_column := column;
  345.     pp := &Objects;
  346.     while pp* ~= nil and
  347.         (pp**.ob_line < line or
  348.          pp**.ob_line = line and pp**.ob_column < column) do
  349.     pp := &pp**.ob_next;
  350.     od;
  351.     p*.ob_next := pp*;
  352.     pp* := p;
  353.     if _scOnScreen(line, column) then
  354.     CRT_PutChar(p*.ob_chars[0]);
  355.     CRT_PutChar(p*.ob_chars[1]);
  356.     fi;
  357. corp;
  358.  
  359. /*
  360.  * scNew - add a new object to the list of objects.
  361.  */
  362.  
  363. proc scNew(Id_t id; long line, column; [2]char chars)void:
  364.     *Object_t p;
  365.  
  366.     p := new(Object_t);
  367.     p*.ob_id := id;
  368.     p*.ob_chars := chars;
  369.     _scInsert(p, line, column);
  370. corp;
  371.  
  372. /*
  373.  * _scFind - find and delete the given object.
  374.  */
  375.  
  376. proc _scFind(Id_t id)*Object_t:
  377.     **Object_t pp;
  378.     *Object_t p;
  379.  
  380.     pp := &Objects;
  381.     while pp* ~= nil and pp**.ob_id ~= id do
  382.     pp := &pp**.ob_next;
  383.     od;
  384.     if pp* = nil then
  385.     _scAbort("_scFind: object does not exist.")
  386.     fi;
  387.     p := pp*;
  388.     pp* := p*.ob_next;
  389.     p
  390. corp;
  391.  
  392. /*
  393.  * scAt - return characters at this location.
  394.  */
  395.  
  396. proc scAt(long line, column)[2]char:
  397.     *Object_t p;
  398.  
  399.     p := Objects;
  400.     while p ~= nil and
  401.         (p*.ob_line < line or
  402.          p*.ob_line = line and p*.ob_column < column) do
  403.     p := p*.ob_next;
  404.     od;
  405.     if p ~= nil and p*.ob_line = line and
  406.         p*.ob_column = column then
  407.     p*.ob_chars
  408.     else
  409.     Scenery(line, column)
  410.     fi
  411. corp;
  412.  
  413. /*
  414.  * _scUndo - make the current view of an object go away.
  415.  */
  416.  
  417. proc _scUndo(Id_t id)*Object_t:
  418.     *Object_t p;
  419.     long line, column;
  420.     [2]char chars;
  421.  
  422.     p := _scFind(id);
  423.     line := p*.ob_line;
  424.     column := p*.ob_column;
  425.     if _scOnScreen(line, column) then
  426.     chars := scAt(line, column);
  427.     CRT_PutChar(chars[0]);
  428.     CRT_PutChar(chars[1]);
  429.     fi;
  430.     p
  431. corp;
  432.  
  433. /*
  434.  * scMove - move an object that is in the list of objects.
  435.  */
  436.  
  437. proc scMove(Id_t id; long line, column)void:
  438.  
  439.     _scInsert(_scUndo(id), line, column);
  440.     if id = ID_NULL and (
  441.         line <= WindowLine - MAPLINES / 2 or
  442.         line >= WindowLine + (MAPLINES - 1) / 2 or
  443.         column <= WindowColumn - MAPCOLUMNS / 2 or
  444.         column >= WindowColumn + (MAPCOLUMNS - 1) / 2) then
  445.     scWindow(line, column);
  446.     fi;
  447. corp;
  448.  
  449. /*
  450.  * scDelete - delete an object.
  451.  */
  452.  
  453. proc scDelete(Id_t id)void:
  454.  
  455.     free(_scUndo(id));
  456. corp;
  457.  
  458. /*
  459.  * _scUpdate - update the screen display of the status object.
  460.  */
  461.  
  462. proc _scUpdate(*Status_t st)void:
  463.     *char ptr;
  464.     [12] char buffer;
  465.     long n;
  466.     ushort col, len, cnt;
  467.     bool isNeg, isFirst, quit;
  468.  
  469.     col := st*.st_column + CharsLen(st*.st_name) + (STATUSLEFT + 2);
  470.     CRT_Move(st*.st_line, col);
  471.     len := st*.st_length;
  472.     case st*.st_kind
  473.     incase st_number:
  474.     ptr := &buffer[11];
  475.     ptr* := '\e';
  476.     n := st*.st_.n_ptr*;
  477.     if n < 0 then
  478.         isNeg := true;
  479.     else
  480.         n := -n;
  481.         isNeg := false;
  482.     fi;
  483.     while
  484.         if len ~= 0 then
  485.         len := len - 1;
  486.         fi;
  487.         ptr* := -(n % 10) + '0';
  488.         n := n / 10;
  489.         n ~= 0
  490.     do
  491.         ptr := ptr - 1;
  492.     od;
  493.     if isNeg then
  494.         if len ~= 0 then
  495.         len := len - 1;
  496.         fi;
  497.         ptr := ptr - 1;
  498.         ptr* := '-';
  499.     fi;
  500.     while len ~= 0 do
  501.         len := len - 1;
  502.         CRT_PutChar(' ');
  503.     od;
  504.     CRT_PutChars(ptr);
  505.     incase st_string:
  506.     ptr := st*.st_.s_ptr*;
  507.     while ptr* ~= '\e' and len ~= 0 do
  508.         len := len - 1;
  509.         CRT_PutChar(ptr*);
  510.         ptr := ptr + 1;
  511.     od;
  512.     while len ~= 0 do
  513.         len := len - 1;
  514.         CRT_PutChar(' ');
  515.     od;
  516.     incase st_multiple:
  517.     cnt := st*.st_line;
  518.     len := cnt + len - 1;
  519.     isFirst := true;
  520.     quit := false;
  521.     while
  522.         if quit then
  523.         false
  524.         else
  525.         ptr := st*.st_.m_gen(isFirst);
  526.         ptr ~= nil
  527.         fi
  528.     do
  529.         if isFirst then
  530.         isFirst := false;
  531.         else
  532.         CRT_PutChars(", ");
  533.         col := col + 2;
  534.         fi;
  535.         if col + CharsLen(ptr) + 2 >= NCOLUMNS - 1 then
  536.         if cnt = len then
  537.             quit := true;
  538.             CRT_PutChars("\b\b..");
  539.         else
  540.             CRT_ClearTail();
  541.             col := st*.st_column + (STATUSLEFT + 2);
  542.             cnt := cnt + 1;
  543.             CRT_Move(cnt, col);
  544.         fi;
  545.         fi;
  546.         if not quit then
  547.         CRT_PutChars(ptr);
  548.         col := CharsLen(ptr) + col;
  549.         fi;
  550.     od;
  551.     while
  552.         CRT_ClearTail();
  553.         cnt < len
  554.     do
  555.         cnt := cnt + 1;
  556.         CRT_Move(cnt, STATUSLEFT + 2);
  557.     od;
  558.     esac;
  559. corp;
  560.  
  561. /*
  562.  * _scAdd - add a new status object.
  563.  */
  564.  
  565. proc _scAdd(Id_t id; *char name; ushort line, column, length;
  566.            *Status_t st)void:
  567.  
  568.     st*.st_next := Statuses;
  569.     st*.st_id := id;
  570.     st*.st_name := name;
  571.     st*.st_line := line;
  572.     st*.st_column := column;
  573.     st*.st_length := length;
  574.     Statuses := st;
  575.     CRT_Move(line, column + STATUSLEFT);
  576.     CRT_PutChars(name);
  577.     CRT_PutChars(": ");
  578.     _scUpdate(st);
  579. corp;
  580.  
  581. /*
  582.  * scNumber - add a number status object.
  583.  */
  584.  
  585. proc scNumber(Id_t id; *char name; ushort line, column, length;
  586.              *long ptr)void:
  587.     *Status_t st;
  588.  
  589.     st := new(Status_t);
  590.     st*.st_kind := st_number;
  591.     st*.st_.n_ptr := ptr;
  592.     _scAdd(id, name, line, column, length, st);
  593. corp;
  594.  
  595. /*
  596.  * scString - add a string status object.
  597.  */
  598.  
  599. proc scString(Id_t id; *char name; ushort line, column, length;
  600.              **char ptr)void:
  601.     *Status_t st;
  602.  
  603.     st := new(Status_t);
  604.     st*.st_kind := st_string;
  605.     st*.st_.s_ptr := ptr;
  606.     _scAdd(id, name, line, column, length, st);
  607. corp;
  608.  
  609. /*
  610.  * scMult - add a multiple status object.
  611.  */
  612.  
  613. proc scMult(Id_t id; *char name; ushort line, column, lines;
  614.            proc(bool first)*char gen)void:
  615.     *Status_t st;
  616.  
  617.     st := new(Status_t);
  618.     st*.st_kind := st_multiple;
  619.     st*.st_.m_gen := gen;
  620.     _scAdd(id, name, line, column, lines, st);
  621. corp;
  622.  
  623. /*
  624.  * scUpdate - update the specified status object.
  625.  */
  626.  
  627. proc scUpdate(Id_t id)void:
  628.     *Status_t st;
  629.  
  630.     st := Statuses;
  631.     while st ~= nil and st*.st_id ~= id do
  632.     st := st*.st_next;
  633.     od;
  634.     if st = nil then
  635.     _scAbort("scUpdate: bad status id.");
  636.     fi;
  637.     _scUpdate(st);
  638. corp;
  639.  
  640. /*
  641.  * scRemove - remove the specified status object.
  642.  */
  643.  
  644. proc scRemove(Id_t id)void:
  645.     **Status_t pst;
  646.     *Status_t st;
  647.     ushort len, line;
  648.  
  649.     pst := &Statuses;
  650.     while pst* ~= nil and pst**.st_id ~= id do
  651.     pst := &pst**.st_next;
  652.     od;
  653.     if pst* = nil then
  654.     _scAbort("scRemove: bad status id.");
  655.     fi;
  656.     st := pst*;
  657.     pst* := st*.st_next;
  658.     CRT_Move(st*.st_line, st*.st_column + STATUSLEFT);
  659.     len := st*.st_length;
  660.     if st*.st_kind = st_multiple then
  661.     line := st*.st_line;
  662.     len := line + len - 1;
  663.     while
  664.         CRT_ClearTail();
  665.         line ~= len
  666.     do
  667.         line := line + 1;
  668.         CRT_Move(line, STATUSLEFT + 2);
  669.     od;
  670.     else
  671.     len := CharsLen(st*.st_name) + len + 2;
  672.     while len ~= 0 do
  673.         len := len - 1;
  674.         CRT_PutChar(' ');
  675.     od;
  676.     fi;
  677.     free(st);
  678. corp;
  679.